home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / ncurses2-genericputs.adb < prev    next >
Text File  |  2002-10-24  |  5KB  |  127 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                                 ncurses                                  --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 2000 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
  37. --  Version Control
  38. --  $Revision: 1.1 $
  39. --  Binding Version 01.00
  40. ------------------------------------------------------------------------------
  41. with Ada.Text_IO; use Ada.Text_IO;
  42. with Ada.Strings.Bounded; use Ada.Strings.Bounded;
  43.  
  44. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  45. with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
  46.  
  47. with Interfaces.C; use Interfaces.C;
  48. with Interfaces.C.Strings; use Interfaces.C.Strings;
  49.  
  50.  
  51. package body ncurses2.genericPuts is
  52.  
  53.    procedure myGet (Win : in  Window := Standard_Window;
  54.                     Str : out BS.Bounded_String;
  55.                     Len : in  Integer := -1)
  56.    is
  57.       use BS;
  58.       function Wgetnstr (Win : Window;
  59.                          Str : char_array;
  60.                          Len : int) return int;
  61.       pragma Import (C, Wgetnstr, "wgetnstr");
  62.  
  63.       N        : Integer := Len;
  64.       Txt : char_array (0 .. size_t (Max_Length));
  65.       xStr : String (1 .. Max_Length);
  66.       Cnt : Natural;
  67.    begin
  68.       if N < 0 then
  69.          N := Max_Length;
  70.       end if;
  71.       if N > Max_Length then
  72.          raise Constraint_Error;
  73.       end if;
  74.       Txt (0) := Interfaces.C.char'First;
  75.       if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
  76.          raise Curses_Exception;
  77.       end if;
  78.       To_Ada (Txt, xStr, Cnt, True);
  79.       Str := To_Bounded_String (xStr (1 .. Cnt));
  80.    end myGet;
  81.  
  82.  
  83.  
  84.    procedure myPut (Str  : out BS.Bounded_String;
  85.                     i    : Integer;
  86.                     Base : in     Number_Base := 10) is
  87.       package Int_IO is new Integer_IO (Integer); use Int_IO;
  88.       tmp : String (1 .. BS.Max_Length);
  89.    begin
  90.       Put (tmp, i, Base);
  91.       Str := To_Bounded_String (tmp);
  92.       Trim (Str, Ada.Strings.Trim_End'(Ada.Strings.Left));
  93.    end myPut;
  94.  
  95.    procedure myAdd (Str : BS.Bounded_String) is
  96.    begin
  97.       Add (Str => To_String (Str));
  98.    end myAdd;
  99.  
  100.    --  from ncurses-aux
  101.    procedure Fill_String (Cp  : in  chars_ptr;
  102.                           Str : out BS.Bounded_String)
  103.    is
  104.       --  Fill the string with the characters referenced by the
  105.       --  chars_ptr.
  106.       --
  107.       Len : Natural;
  108.    begin
  109.       if Cp /= Null_Ptr then
  110.          Len := Natural (Strlen (Cp));
  111.          if Max_Length < Len then
  112.             raise Constraint_Error;
  113.          end if;
  114.          declare
  115.             S : String (1 .. Len);
  116.          begin
  117.             S := Value (Cp);
  118.             Str := To_Bounded_String (S);
  119.          end;
  120.       else
  121.          Str := Null_Bounded_String;
  122.       end if;
  123.  
  124.    end Fill_String;
  125.  
  126. end ncurses2.genericPuts;
  127.